670 IF SM(0)<1 THEN SY(0)=SY(0)-1 : SM(0)=12 : IF SY(0)<1583 THEN SY(0)=1583 : SM(0)=1 : SD(0)=1
680 IF SM(0)>12 THEN SY(0)=SY(0)+1 : SM(0)=1 : IF SY(0)>9998 THEN SY(0)=9998 : SM(0)=12 : SD(0)=31
690 GOSUB 3830 : GOTO *メイン
700 SD(1)=SD(1)+CX*2-1
710 IF SD(1)<1 THEN SM(1)=SM(1)-1 : IF SM(1)<1 THEN SY(1)=SY(1)-1 : SM(1)=12 : SD(1)=31 : IF SY(1)<1583 THEN SY(1)=1583 : SM(1)=1 : SD(1)=1 ELSE 720 ELSE SD(1)=MONTH(SM(1))
720 IF SD(1)>MONTH(SM(1)) THEN SM(1)=SM(1)+1 : IF SM(1)>12 THEN SY(1)=SY(1)+1 : SM(1)=1 : SD(1)=1 : IF SY(1)>9998 THEN SY(1)=9998 : SM(1)=12 : SD(1)=31 ELSE 730 ELSE SD(1)=1
730 GOSUB 3830 : GOTO *メイン
740 SD(2)=SD(2)+(CX*2-1)*7
750 IF SD(2)<1 THEN SM(2)=SM(2)-1 : IF SM(2)<1 THEN SY(2)=SY(2)-1 : SM(2)=12 : SD(2)=31+SD(2) : IF SY(2)<1583 THEN SY(2)=1583 : SM(2)=1 : SD(2)=1 ELSE 760 ELSE SD(2)=MONTH(SM(2))+SD(2)
760 IF SD(2)>MONTH(SM(2)) THEN CG=SD(2)-MONTH(SM(2)) : SM(2)=SM(2)+1 : IF SM(2)>12 THEN SY(2)=SY(2)+1 : SM(2)=1 : SD(2)=CG : IF SY(2)>9998 THEN SY(2)=9998 : SM(2)=12 : SD(2)=31 ELSE 770 ELSE SD(2)=CG
770 GOSUB 3830 : GOTO *メイン
780 PIP=IP : IP=IP+CX*2-1 : IF IP<1 THEN IP=1
790 IF (IP-1)*5+1>INI THEN IP=IP-1 : GOTO 790
800 IF PIP<>IP THEN GOSUB 3830 : GOTO *メイン ELSE GOTO *メイン
810 '
820 'ウインドウを動かす
830 '
840 IF MY>WSY(MW)+31 OR WIN(MW)=8 THEN GOSUB *WINDOW : GOTO *メイン
850 BGM 1 : PLAY OFF : PLAY "@29o4c4" : DQDQ=MOUSE(9) : DQDQ=MOUSE(10)
2460 GOSUB *WIN閉 : PP=1 : GOSUB *WIN変 : IF RX=3 THEN RETURN
2470 IF WIN(1)=6 THEN 2700 ELSE IF WIN(1)<>3 THEN RETURN
2480 CLS 1 : IF LEN(IN$)>32 THEN IN$=LEFT$(IN$,32)
2490 ASS=11 : KQS=0 : FOR Y=10 TO 1 STEP -1 : IF SCA$(SMF,Y)="" THEN ASS=Y
2500 NEXT : IF RX=1 THEN IF SCA$(SMF,SMY)="" THEN RX=0
2510 IF RX=0 THEN KQS=1 : IF SCA$(SMF,SMY)="" AND ASS<11 THEN SCA$(SMF,ASS)=IN$ : CK(SMF,ASS)=0 : DD(SMF,ASS)=DDD ELSE SCA$(SMF,SMY)=IN$ : CK(SMF,SMY)=0 : DD(SMF,SMY)=DDD
2520 IF RX=1 THEN IF SCA$(SMF,10)="" THEN KQS=1 : FOR Y=ASS-1 TO SMY STEP -1 : SCA$(SMF,Y+1)=SCA$(SMF,Y) : CK(SMF,Y+1)=CK(SMF,Y) : DD(SMF,Y+1)=DD(SMF,Y) : NEXT : SCA$(SMF,SMY)=IN$ : CK(SMF,SMY)=0 : DD(SMF,SMY)=DDD
2530 IF RX<>2 OR SCA$(SMF,SMY)="" THEN 2570 ELSE IF ASS>10 THEN ASS=10 : LJK=1 ELSE LJK=0
2540 KQS=1 : IF SMY<10 THEN FOR Y=SMY+1 TO ASS : SCA$(SMF,Y-1)=SCA$(SMF,Y) : CK(SMF,Y-1)=CK(SMF,Y) : DD(SMF,Y-1)=DD(SMF,Y) : NEXT
2550 IF LJK=1 THEN SCA$(SMF,10)="" : CK(SMF,10)=0 : DD(SMF,10)=0 : LJK=0
2560 IF SCA$(SMF,1)="" THEN FOR Y=SMF TO MG : SYEA(Y)=SYEA(Y+1) : SMON(Y)=SMON(Y+1) : SDAY(Y)=SDAY(Y+1) : FOR Y2=1 TO 10 : SCA$(Y,Y2)=SCA$(Y+1,Y2) : CK(Y,Y2)=CK(Y+1,Y2) : DD(Y,Y2)=DD(Y+1,Y2) : NEXT : NEXT : MG=MG-1
2570 IF KQS=1 AND MFG=1 THEN MG=MG+1 : IF MG=501 THEN MG=MG-1 : ERROR 21 ELSE MFG=0 : SYEA(MG)=SY(1) : SMON(MG)=SM(1) : SDAY(MG)=SD(1)
2580 IF KQS=1 THEN KSS=1 : WSX=WSX(1) : WSY=WSY(1) : WEX=WEX(1) : WEY=WEY(1) : WIN=WIN(1) : GOSUB 3830
2590 RETURN
2600 GOSUB *KON : LOCATE 27,23 : COLOR 0,,,4 : LINE INPUT "表示したい年:",AY$ : GOSUB *KOFF : AY=VAL(AY$) : IF AY<1583 OR AY>9998 THEN 2640
2610 GOSUB *KON : LOCATE 27,23 : COLOR 0,,,4 : LINE INPUT "表示したい月:",AM$ : GOSUB *KOFF : AM=VAL(AM$) : IF AM<1 OR AM>12 THEN 2640
2620 IF YMD=1 THEN JNJ=1 : GOTO 2640 ELSE YEAR=AY : MONTH=AM : TODAY=1 : GOSUB *WEEK
2630 GOSUB *KON : LOCATE 27,23 : COLOR 0,,,4 : LINE INPUT "表示したい日:",AD$ : GOSUB *KOFF : AD=VAL(AD$) : IF AD>0 AND AD<=MONTH(AM) THEN JNJ=1
2640 IF JNJ=1 THEN SY(WIN(2)-2)=AY : SM(WIN(2)-2)=AM : IF YMD=2 THEN SD(WIN(2)-2)=AD
2840 LINE (WSX(1)+80,WSY(1)+36)-(WSX(1)+95,WSY(1)+99),PSET,%0,BF,%ECC
2850 FOR C=0 TO 2 : LINE (WSX(1)+126,WSY(1)+37+C*24)-(WSX(1)+141,WSY(1)+52+C*24),PSET,%12,BF : SYMBOL (WSX(1)+126,WSY(1)+37+C*24),RIGHT$(STR$(PAL(ECC,C)),2),1,1,%7 : NEXT
2960 LINE (WSX(1)+126,WSY(1)+37+RY*24)-(WSX(1)+141,WSY(1)+52+RY*24),PSET,%12,BF : SYMBOL (WSX(1)+126,WSY(1)+37+RY*24),RIGHT$(STR$(PAL(ECC,RY)),2),1,1,%7
2970 MMJ=1 : GOTO 2860
2980 RX=(MX-WSX(1)-129) MOD 40 : RY=MY-WSY(1)-117
2990 IF RX<0 OR RX>15 OR RY<0 OR RY>15 THEN RETURN
3000 RX=(MX-WSX(1)-129) \ 40 : IF RX<0 OR RX>1 THEN RETURN
4180 IF LXW=1 AND KSS=1 THEN FOR CH=1 TO MONTH(MONTH) : TIX=((WS+CH-1) MOD 7)*40+WSX+3 : TIY=WSY+((WS+CH-1)\7)*24+66 : LINE (TIX,TIY)-(TIX+3,TIY+3),PSET,%12,BF : NEXT : GOTO 4280
4190 MZ=0 : FOR Y=1 TO MQ
4200 IF CYEA(Y)=YEAR AND CMON(Y)=MONTH THEN TIX=((WS+CDAY(Y)-1) MOD 7)*40+WSX+8 : TIY=WSY+((WS+CDAY(Y)-1)\7)*24+60 : LINE (TIX,TIY)-(TIX+31,TIY+15),PSET,%10,BF
4210 NEXT
4220 FOR CH=1 TO MONTH(MONTH)
4230 HI$=AKCNV$(RIGHT$(STR$(CH),2))
4240 IF WEEK=0 THEN TIX=WEEK*40+WSX+8 : TIY=WSY+((CH+WS-1)\7)*24+60 : GET@A (TIX,TIY)-(TIX,TIY),V% : LINE (TIX,TIY)-(TIX+31,TIY+15),PSET,%10-(V%(0)=10)*2,BF
4760 IF Y=0 OR Y=6 THEN SYMBOL(WSX+64-(Y=6)*128,WSY+36),YEAR$+MONTH$+SDAY$+LEFT$("≫",-(Y=0)*2),1,1,%2
4770 SYMBOL (WSX+8,WSY+60+Y*24),MONTH$+SDAY$+"("+WEEK$(Y)+")",1,1,%2
4780 NEXT
4790 YEAR=SY(3) : MONTH=SM(3) : TODAY=SD(3) : GOSUB *WEEK : IF RDAY-IIDAY>=0 AND RDAY-IIDAY<7 THEN LINE (WSX+4,WSY+56+(RDAY-IIDAY)*24)-(WSX+371,WSY+79+(RDAY-IIDAY)*24),PSET,%5,B
4800 FOR MF=1 TO MG
4810 YEAR=SYEA(MF) : MONTH=SMON(MF) : TODAY=SDAY(MF) : GOSUB *WEEK : IF RDAY-IIDAY<0 OR RDAY-IIDAY>6 THEN 4860
4820 SG=1 : WHILE SG<11
4830 IF SCA$(MF,SG)="" THEN SG=10 ELSE IF CK(MF,SG)=0 THEN 4850
4840 SG=SG+1 : WEND : GOTO 4860
4850 SYMBOL (WSX+112,WSY+60+(RDAY-IIDAY)*24),SCA$(MF,SG),1,1,%7
4860 NEXT
4870 GOTO 5400
4880 '
4890 '時間割作成
4900 '
4910 FOR Y=0 TO 7 : LINE (WSX+10,WSY+38+Y*20)-(WSX+334,WSY+38+Y*20),PSET,%9,,&HAAAA : NEXT
4920 FOR Y=0 TO 6 : LINE (WSX+Y*52+22,WSY+38)-(WSX+Y*52+22,WSY+178),PSET,%9,,&HAAAA : NEXT
4930 LINE (WSX+10,WSY+38)-(WSX+10,WSY+178),PSET,%9,,&HAAAA
5810 DQDQ=MOUSE(9) : DQDQ=MOUSE(10) : BGM 1 : PLAY OFF : PLAY "t120o4l2@24e" : WHILE MOUSE(2,0)=-1 AND MOUSE(9)=0 AND MOUSE(10)=0 : WEND : PLAY OFF : PLAY "l2@24c" : RETURN
5820 *WEEK
5830 MONTH(2)=28-((YEAR MOD 4)=0)+((YEAR MOD 100)=0)-((YEAR MOD 1000)=0)
5840 DAY=0
5850 FOR CH=0 TO MONTH-1
5860 DAY=DAY+MONTH(CH)
5870 NEXT
5880 DAY=DAY+TODAY : RDAY=(DAY+YEAR*365+INT((YEAR+3)/4)+4) : WEEK=RDAY MOD 7
5890 RETURN
5900 *INFO
5910 ERASE IND,INH,INN : DIM IND(2000),INH(2000),INN(2000)
5930 FOR I=1 TO MG : YEAR=SYEA(I) : MONTH=SMON(I) : TODAY=SDAY(I) : GOSUB *WEEK
5940 FOR Q=1 TO 10 : IF SCA$(I,Q)="" THEN Q=11 ELSE IF CK(I,Q)=1 THEN 5950 ELSE IF DD(I,Q)>=RDAY-TDAY THEN INI=INI+1 : IND(INI)=RDAY-TDAY : INN(INI)=I : INH(INI)=Q
5950 NEXT
5960 NEXT : YEAR=TYEAR : MONTH=TMONTH : TODAY=TTODAY : IF INI<2 THEN RETURN
5970 FOR I=1 TO INI-1 : FOR Q=1 TO INI-I
5980 IF IND(Q)>IND(Q+1) THEN SWAP IND(Q),IND(Q+1) : SWAP INN(Q),INN(Q+1) : SWAP INH(Q),INH(Q+1)
5990 NEXT : NEXT : RETURN
6000 *初期画面
6010 DIM BG%(140000),ICN%(2879),MSG%(2879),MNU%(3071),MONTH(12)
6020 DIM SCA$(501,10),DD(501,10),CK(501,10),ZIKAN$(5,5),SYEA(501)
6030 DIM SMON(501),SDAY(501),IND(501),INH(501),INN(501),CYEA(1001)